home *** CD-ROM | disk | FTP | other *** search
/ The Atari Compendium / The Atari Compendium (Toad Computers) (1994).iso / files / prgtools / programm.ing / gfa / gemshell.lzh / GEMSHELL.GFA (.txt)
Encoding:
GFA-BASIC Atari  |  1992-08-29  |  5.7 KB  |  143 lines
  1. ' GEM Shell
  2. ' by John Eidsvoog
  3. ' Saturday, August 29, 1992
  4. '
  5. ' This program show how windows can be correctly manipulated in GFA
  6. ' in the manner in which GEM was designed, rather than resorting to
  7. ' techniques such as "Use ACCs" options to avoid handling redraw messages
  8. ' correctly.
  9. '
  10. ' GEM Shell may be freely distributed, dissected, and any portion may be used
  11. ' in any way you deem necessary.  Hopefully, it will inspire more programmers
  12. ' to follow the recommended rules of GEM programming.
  13. '
  14. @init
  15. ON MENU MESSAGE GOSUB message
  16. ON MENU GOSUB menuselect
  17. ON MENU KEY GOSUB mkey
  18. exit%=FALSE
  19. REPEAT
  20.   ON MENU
  21. UNTIL exit%
  22. CLOSEW #1
  23. '
  24. > PROCEDURE init                     ! Initialize things
  25.   DEFINT "a-z"    ! Make 'em all integers
  26.   DIM menu$(14)
  27.   FOR x%=0 TO 14   ! Read in menubar strings
  28.     READ menu$(x%)
  29.   NEXT x%
  30.   '
  31.   DATA "Desk","  About GEM Shell  ",--------------------,1,2,3,4,5,6,""
  32.   DATA "File","  Quit   ",""
  33.   DATA "",""
  34.   '
  35.   GEMSYS 77              ! graf_handle
  36.   xchar%=INT{GINTOUT+2}   ! character width
  37.   ychar%=INT{GINTOUT+4}   ! character height
  38.   '
  39.   ~APPL_INIT()
  40.   '
  41.   MENU menu$()
  42.   ~WIND_GET(0,4,wx%,wy%,ww%,wh%)        ! Get work area of the desktop
  43.   ~FORM_DIAL(3,0,0,0,0,wx%,wy%,ww%,wh%) ! Send a redraw message to the desktop
  44.   wx%=ww%/2-xchar%*17-7     ! Set up a default window size and center it
  45.   wy%=wh%/2-ychar%*6
  46.   ww%=xchar%*34
  47.   wh%=ychar%*14
  48.   TITLEW #1," GEM Shell "
  49.   INFOW #1,""
  50.   OPENW #1,wx%,wy%,ww%,wh%,&X101111    ! Open our window
  51.   handle%=W_HAND(#1)
  52. RETURN
  53. > PROCEDURE message                  ! Handle GEM messages
  54.   wx%=MENU(5)   ! intout coordinates
  55.   wy%=MENU(6)
  56.   ww%=MENU(7)
  57.   wh%=MENU(8)
  58.   '
  59.   SELECT MENU(1) ! Get message type
  60.   CASE 20        ! WM_REDRAW
  61.     @redraw
  62.   CASE 21        ! WM_TOPPED
  63.     TOPW #1
  64.   CASE 22        ! WM_CLOSED
  65.     @quit
  66.   CASE 23        ! WM_FULLED
  67.     full%=1-full%  ! Toggle between full and normal
  68.     IF full%
  69.       ox%=wx%      ! If we're going to "full", save old window size
  70.       oy%=wy%
  71.       ow%=ww%
  72.       oh%=wh%
  73.       FULLW #1
  74.     ELSE         ! Otherwise set it back to old size
  75.       ~WIND_SET(handle%,5,ox%,oy%,ow%,oh%)
  76.     ENDIF
  77.   CASE 27       ! WM_SIZED
  78.     full%=0
  79.     ~WIND_SET(handle%,5,wx%,wy%,MAX(180,ww%),MAX(80,wh%))
  80.   CASE 28       ! WM_MOVED
  81.     full%=0
  82.     ~WIND_SET(handle%,5,wx%,wy%,ww%,wh%)
  83.   ENDSELECT
  84. RETURN
  85. > PROCEDURE menuselect               ! Handle menubar selections
  86.   SELECT MENU(5)
  87.   CASE 23
  88.     @about   ! Open the "About" alert box
  89.   CASE 32
  90.     @quit    ! Bail out
  91.   ENDSELECT
  92.   MENU OFF
  93. RETURN
  94. > PROCEDURE mkey                     ! Handle keypresses
  95.   k$=UPPER$(CHR$(MENU(14) AND 255))
  96.   SELECT k$
  97.   CASE " "      ! Spacebar brings up About box
  98.     @about
  99.   CASE "Q",27   ! Q or Esc quits program
  100.     @quit
  101.   ENDSELECT
  102. RETURN
  103. > PROCEDURE about                    ! Tell 'em what we've got, Bob.
  104.   ALERT 1," | GEM Shell | By John Eidsvoog ",1," OK ",b%
  105. RETURN
  106. > PROCEDURE redraw                   ! Walk the rectangle list and do redraws
  107.   ~WIND_UPDATE(1)                  ! Lock out other activity while we redraw
  108.   ~WIND_GET(handle%,11,rx%,ry%,rw%,rh%) ! Get first rectangle in the list
  109.   ~WIND_GET(handle%,4,ax%,ay%,aw%,ah%)  ! Work area of our window
  110.   REPEAT
  111.     IF RC_INTERSECT(ax%,ay%,aw%,ah%,rx%,ry%,rw%,rh%)  ! Find intersection
  112.       CLIP rx%,ry%,rw%,rh% OFFSET ax%,ay%     ! Set clipping to the area in question
  113.       CLEARW #1                         ! Clear the area
  114.       @fillwindow                       ! Call our routine to redraw the area
  115.       CLIP 0,0,WORK_OUT(0),WORK_OUT(1)  ! Reset full-screen clipping
  116.     ENDIF
  117.     ~WIND_GET(handle%,12,rx%,ry%,rw%,rh%) ! Get next rectangle in the list
  118.   UNTIL rw%=0 AND rh%=0                ! Keep repeating until no more rectangles
  119.   ~WIND_UPDATE(0)                    ! Reenable other GEM activity
  120. RETURN
  121. > PROCEDURE fillwindow               ! Redraw sections of our window
  122.   ' Replace this routine with whatever is needed to redraw your window.
  123.   TEXT 8,ychar%," This is some sample text,"
  124.   TEXT 8,2*ychar%," showing how redraws can"
  125.   TEXT 8,3*ychar%," be handled correctly in"
  126.   TEXT 8,4*ychar%," GFA while still following"
  127.   TEXT 8,5*ychar%," GEM guidelines for multiple"
  128.   TEXT 8,6*ychar%," windows.  This window can"
  129.   TEXT 8,7*ychar%," be resized, moved, or made"
  130.   TEXT 8,8*ychar%," 'full', and windowed ACCs"
  131.   TEXT 8,9*ychar%," made be opened and manipu-"
  132.   TEXT 8,10*ychar%," lated without redraw"
  133.   TEXT 8,11*ychar%," problems."
  134. RETURN
  135. > PROCEDURE quit
  136.   ALERT 3," | Do you want to quit? | ",1," Quit | No ",b%
  137.   IF b%=1
  138.     CLOSEW #1
  139.     ~APPL_EXIT()
  140.     exit%=TRUE
  141.   ENDIF
  142. RETURN
  143.